{$IFDEF FPC}{$mode objfpc}{$ENDIF}
unit tagparser;

interface
uses sysutils, StrUtils;

Type     TParserProc = Function(s: widestring): widestring;Const
     LeftMarker   = '<';
     RightMarker  = '>';
     PageMarker   = 'xpage';
     ImgMarker    = 'xphoto';
     LeftLen      = Length(LeftMarker);
     RightLen     = Length(RightMarker);

function ParsePage(path: widestring): WideString;
function ReadPage(path: widestring): WideString;


implementation

function ReadF(pth: widestring): widestring;
  var
     F            : File of char;
     numread,i    : integer;
     buf          : array[1..2048]of char;
     total        : longint;
  begin
    Result:='';
    if not FileExists(pth)then exit;
    AssignFile(F,pth);
    Reset(F);
    total:=0;
    repeat
      BlockRead(F,buf,SizeOf(buf),NumRead);
      inc(total,numread);
      if(NumRead<1)then break;
      for i:=1 to NumRead do Result:=Result+buf[i];
    until numread=0;
    CloseFile(F);
  end;

function ReadPage(path: widestring): WideString;
  begin
   Result:=''; if not FileExists(path)then exit;
   Result:=ReadF(path);
  end;

function ParseProc(text,marker: widestring; PProc: TParserProc): WideString;
  var a,b,ml: integer; s: widestring;
  begin
   Result:=text; text:='';
   marker:=LeftMarker+marker; ml:=Length(marker);
   repeat
    a:=Pos(Marker,Result); if(a=0)then exit;
    b:=PosEx(RightMarker,Result,a); if(b=0)then exit;
    s:=Copy(Result,a+1+ml,b-a-1-ml);
    Delete(Result,a,b-a+1);
    //Result:=text; text:='';
    b:=Pos('=',s); if(b=0)then exit;
    Delete(s,1,b);
    while Copy(s,1,1)=' ' do Delete(s,1,1);
    while Copy(s,Length(s),1)=' ' do Delete(s,Length(s),1);
//    if not FileExists(s)then exit;
    If Assigned(PProc)then s:=PProc(s);//ReadPage(s);
    Insert(s,Result,a);
   until false;
   s:='';
  end;

  function ParsePagePProc(s: widestring): WideString;
  begin
   Result:=ReadPage(s);
  end;
function ParsePages(P: widestring): WideString;
  begin
   Result:=ParseProc(P,PageMarker,@ParsePagePProc);
  end;

  function ThumbPath(s: widestring): widestring;
  var p,i: integer; c: char;
  begin
   p:=Pos('/',s); i:=Pos('\',s);
   if(p>0)then c:='/' else c:='\';
   if(p=0)and(i=0)then begin Result:='_'+Result; exit; end;
   if(p=0)then p:=i;
   while PosEx(c,s,p+1)>0 do p:=PosEx(c,s,p+1);
   Insert('_',s,p+1); Result:=s;
  end;
  function ParsePhotoPProc(s: widestring): WideString;
  var PhotoExists,ThumbnailExists: Boolean;
  ts: widestring;
  begin
   Result:='';
   ts:=ThumbPath(s);
   PhotoExists    :=FileExists(s);
   ThumbnailExists:=FileExists(ts);
   if (PhotoExists=false)or(ThumbnailExists=false)then exit;
   Result:='<a href="'+s+'"><img src="'+ts+'" alt="photo preview" /></a>'#13;
  end;
function ParsePhotos(P: widestring): WideString;
  begin
   Result:=ParseProc(P,ImgMarker,@ParsePhotoPProc);
  end;

function ParsePage(path: widestring): WideString;
  begin
   Result:=ReadPage(path);
   Result:=ParsePages(Result);
   Result:=ParsePhotos(Result);
  end;


Begin
End.
